home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / print / gs261ini.zip / FONT2C.PS < prev    next >
Text File  |  1993-05-26  |  15KB  |  501 lines
  1. %    Copyright (C) 1992, 1993 Aladdin Enterprises.  All rights reserved.
  2. %
  3. % This file is part of Ghostscript.
  4. %
  5. % Ghostscript is distributed in the hope that it will be useful, but
  6. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  7. % to anyone for the consequences of using it or for whether it serves any
  8. % particular purpose or works at all, unless he says so in writing.  Refer
  9. % to the Ghostscript General Public License for full details.
  10. %
  11. % Everyone is granted permission to copy, modify and redistribute
  12. % Ghostscript, but only under the conditions described in the Ghostscript
  13. % General Public License.  A copy of this license is supposed to have been
  14. % given to you along with Ghostscript so you can know your rights and
  15. % responsibilities.  It should be in a file named COPYING.  Among other
  16. % things, the copyright notice and this notice must be preserved on all
  17. % copies.
  18.  
  19. % font2c.ps
  20. % Write out a Type 1 font as C code that can be linked with Ghostscript.
  21. % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  22. % switch in the command line.  The code is reentrant and has no
  23. % external references, so it can be shared.
  24.  
  25. % Define the maximum string length that will get by the compiler.
  26. % This must be approximately
  27. %    min(max line length, max string literal length) / 4 - 5.
  28.  
  29. /max_wcs 50 def
  30.  
  31. % ------ Protection utilities ------ %
  32.  
  33. % Protection values are represented by a mask:
  34. /a_noaccess 0 def
  35. /a_executeonly 1 def
  36. /a_readonly 3 def
  37. /a_all 7 def
  38. /prot_names
  39.  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  40.  ] def
  41. /prot_opers
  42.  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  43.  ] def
  44.  
  45. % Get the protection of an object.
  46.    /getpa
  47.     { dup wcheck
  48.        { pop a_all }
  49.        {    % Check for executeonly or noaccess objects in protected.
  50.          dup protected exch known
  51.       { protected exch get }
  52.       { pop a_readonly }
  53.      ifelse
  54.        }
  55.       ifelse
  56.     } bind def
  57.  
  58. % Get the protection appropriate for (all the) values in a dictionary.
  59.    /getva
  60.     { a_noaccess exch
  61.        { exch pop
  62.          dup type dup /stringtype eq exch /arraytype eq or
  63.       { getpa a_readonly and or }
  64.       { pop pop a_all exit }
  65.      ifelse
  66.        }
  67.       forall
  68.     } bind def
  69.  
  70. % Keep track of executeonly and noaccess objects,
  71. % but don't let the protection actually take effect.
  72. /protected        % do first so // will work
  73.   systemdict wcheck { 1500 dict } { 1 dict } ifelse
  74. def
  75. systemdict wcheck
  76.  { systemdict begin
  77.      /executeonly
  78.       { dup //protected exch a_executeonly put readonly
  79.       } bind odef
  80.      /noaccess
  81.       { dup //protected exch a_noaccess put readonly
  82.       } bind odef
  83.    end
  84.  }
  85.  { (Warning: you will not be able to convert protected fonts.\n) print
  86.    (If you need to convert a protected font,\n) print
  87.    (please restart Ghostscript with the -dWRITESYSTEMDICT switch.\n) print
  88.    flush
  89.  }
  90. ifelse
  91.  
  92. % ------ Output utilities ------ %
  93.  
  94. % By convention, the output file is named cfile.
  95.  
  96. % Define some utilities for writing the output file.
  97.    /wtstring 100 string def
  98.    /wb {cfile exch write} bind def
  99.    /ws {cfile exch writestring} bind def
  100.    /wl {ws (\n) ws} bind def
  101.    /wt {wtstring cvs ws} bind def
  102.  
  103. % Write a C string.  Some compilers have unreasonably small limits on
  104. % the length of a string literal or the length of a line, so every place
  105. % that uses wcs must either know that the string is short,
  106. % or be prepared to use wcca instead.
  107.    /wbx
  108.     { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
  109.     } bind def
  110.    /wcst
  111.     [
  112.       32 { /wbx load } repeat
  113.       95 { /wb load } repeat
  114.       129 { /wbx load } repeat
  115.     ] def
  116.    ("\\) { wcst exch { (\\) ws wb } put } forall
  117.    /wcs
  118.     { (") ws { dup wcst exch get exec } forall (") ws
  119.     } bind def
  120.    /can_wcs    % Test if can use wcs
  121.     { length max_wcs le
  122.     } bind def
  123.    /wncs    % name -> C string
  124.     { wtstring cvs wcs
  125.     } bind def
  126. % Write a C string as an array of character values.
  127. % We only need this because of line and literal length limitations.
  128.    /wca        % string prefix suffix ->
  129.     { 0 4 -2 roll exch
  130.        { exch ws
  131.          exch dup 19 ge { () wl pop 0 } if 1 add
  132.      exch wt (,)
  133.        } forall
  134.       pop pop ws
  135.     } bind def
  136.    /wcca
  137.     { ({\n) (}) wca
  138.     } bind def
  139.  
  140. % Write object protection attributes.  Note that dictionaries are
  141. % the only objects that can be writable.
  142.    /wpa
  143.     { dup xcheck { (a_executable+) ws } if
  144.       dup type /dicttype eq { getpa } { getpa a_readonly and } ifelse
  145.       prot_names exch get ws
  146.     } bind def
  147.    /wva
  148.     { getva prot_names exch get ws
  149.     } bind def
  150.  
  151. % ------ Object writing ------ %
  152.  
  153.    /wnstring 128 string def
  154.  
  155. % Write a string/name or null as an element of a string/name/null array. */
  156.    /wsn
  157.     { dup null eq
  158.        { pop (\t255,255,) wl
  159.        }
  160.        { dup type /nametype eq { wnstring cvs } if
  161.          dup length 256 idiv wt (,) ws
  162.      dup length 256 mod wt
  163.      (,) (,\n) wca
  164.        }
  165.       ifelse
  166.     } bind def
  167. % Write a packed string/name/null array.
  168.    /wsna    % name (string/name/null)* ->
  169.     { (\tstatic const char ) ws exch wt ([] = {) wl
  170.       { wsn } forall
  171.       (\t0\n};) wl
  172.     } bind def
  173.  
  174.  
  175. % Write a named object.  Return true if this was possible.
  176. % Legal types are: boolean, integer, name, real, string,
  177. % array of (integer, integer+real, name, null+string).
  178. % Dictionaries are handled specially.  Other types are ignored.
  179.    /isall    % array proc -> bool
  180.     { true 3 -1 roll
  181.        { 2 index exec not { pop false exit } if }
  182.       forall exch pop
  183.     } bind def
  184.    /wott 7 dict dup begin
  185.       /arraytype
  186.        { woatt
  187.           { aload pop 2 index 2 index isall
  188.          { exch pop exec exit }
  189.          { pop pop }
  190.         ifelse
  191.       }
  192.      forall
  193.        } bind def
  194.       /booleantype
  195.        { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
  196.          wt (\);) wl true
  197.        } bind def
  198.       /dicttype
  199.        { dup alldicts exch known
  200.           { alldicts exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
  201.       { pop pop false }
  202.      ifelse
  203.        } bind def
  204.       /integertype
  205.        { (\tmake_int\(&) ws exch wt (, ) ws
  206.          wt (\);) wl true
  207.        } bind def
  208.       /nametype
  209.        { (\tcode = (*pprocs->name_create)\(&) ws exch wt
  210.          (, ) ws wnstring cvs wcs    % OK, names are short
  211.      (\);) wl
  212.      (\tif ( code < 0 ) return code;) wl
  213.      true
  214.        } bind def
  215.       /realtype
  216.        { (\tmake_real\(&) ws exch wt (, ) ws
  217.          wt (\);) wl true
  218.        } bind def
  219.       /stringtype
  220.        { ({\tstatic const char s_[] = ) ws
  221.          dup dup can_wcs { wcs } { wcca } ifelse
  222.      (;) wl
  223.      (\tmake_const_string\(&) ws exch wt
  224.      (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
  225.      (}) wl true
  226.        } bind def
  227.    end def
  228.    /wo        % name obj -> OK
  229.     { dup type wott exch known
  230.        { dup type wott exch get exec }
  231.        { pop pop false }
  232.       ifelse
  233.     } bind def
  234.  
  235. % Write an array (called by wo).
  236.    /wnuma    % name array C_type type_v ->
  237.     { ({\tstatic const ref_\() ws exch ws
  238.       (\) a_[] = {) wl exch
  239.       dup length 0 eq
  240.        { (\t0) wl
  241.        }
  242.        { dup
  243.           { (\t) ws 2 index ws (\() ws wt (\),) wl
  244.       } forall
  245.        }
  246.       ifelse
  247.       (\t};) wl exch pop
  248.       (\tmake_array\(&) ws exch wt
  249.       (, ) ws dup wpa (, ) ws length wt
  250.       (, (ref *)a_\);) wl (}) wl
  251.     } bind def
  252.    /woatt [
  253.     % Integers
  254.      { { type /integertype eq }
  255.        { (long) (integer_v) wnuma true }
  256.      }
  257.     % Integers + reals
  258.      { { type dup /integertype eq exch /realtype eq or }
  259.        { (float) (real_v) wnuma true }
  260.      }
  261.     % Strings + nulls
  262.      { { type dup /nulltype eq exch /stringtype eq or }
  263.        { ({) ws dup (sa_) exch wsna
  264.      exch (\tcode = (*pprocs->string_array_create)\(&) ws wt
  265.      (, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
  266.      (\tif ( code < 0 ) return code;) wl
  267.      (}) wl true
  268.        }
  269.      }
  270.     % Names
  271.      { { type /nametype eq }
  272.        { ({) ws dup (na_) exch wsna
  273.      exch (\tcode = (*pprocs->name_array_create)\(&) ws wt
  274.      (, na_, ) ws length wt (\);) wl
  275.      (\tif (